BMUG Revelations/BMUG Revelations.toast/Business/Random/PC to Mac Conversion/PC2MAC.PRG/PC2MAC.PRG

Text File | 1992-05-29 | 51KB | 1,587 lines

******************************************************************************
*** pc2mac.prg
*** demonstrating PC to Mac conversion
*** (c) Nancy Jacobsen, 1990
******************************************************************************
set procedure to PC2MAC
clear all
set safety off
set escape off
set status off
set delim off
set scoreboard off
set exact on
set talk off
set bell off

*** establish public variables
*** mmac is a logical variable that determines whether program is
***         running on a Macintosh

public MMAC,CCLBOX,CCLTITLE,CCLTEXT,CCLMENU,CCLGET,CCLWARN,WWTEXT
MMAC=.f.

*** determine if program is running on a Macintosh

if sys(17)='68000' .or. sys(17)='68010' .or. sys(17)='68020' .or. ;
      sys(17)='68030'
   store .t. to MMAC
endif

*** establish that correct version of Foxbase is being used
if MMAC
   if .not. '2.00'$upper(version()) .and. .not. '2.01'$upper(version())
      clear
      @ 10,17 say 'THIS PROGRAM **MUST** OPERATE UNDER FOXPLUS MAC OR'
      @ 12,17 say '      RUNTIME VERSION 2.00 OR GREATER'
      @ 14,17 say '  RUNTIME 2.00 IS INCLUDED WITH DISPLAY/390'
      @ 16,15 say 'IF YOU HAVE ANY QUESTIONS, CALL DISPLAY/390 SUPPORT'
      @ 23,0
      wait
      quit
   endif
else
   if '2.00'$upper(version()) .or. '1.00'$upper(version())
      clear
      @ 10,17 say 'THIS PROGRAM **MUST** OPERATE UNDER FOXPLUS OR'
      @ 12,17 say '      FOXPRUN VERSION 2.10 OR GREATER'
      @ 14,17 say '  RUNTIME 2.10 IS INCLUDED WITH DISPLAY/390'
      @ 16,15 say 'IF YOU HAVE ANY QUESTIONS, CALL DISPLAY/390 SUPPORT'
      @ 23,0
      wait
      set color to
      quit
   endif
endif

*** Macintosh screen commands

if MMAC
   screen type 8 at 0,0           && chooses round bordered screen & centers it
   screen FONT "Monaco",9         && chooses a 9 point Monaco font
   screen heading "DISPLAY/390"   && creates a title for the screen
   screen lock                       && disables ability to close screen
                                  && LOCK should always come last

   *** these commands may also be combined as in:
   *** SCREEN TYPE 8 AT 0,0 FONT "Monaco",9 HEADING "DISPLAY/390" LOCK
endif

*** Macintosh printer commands (if printing to COM port)
*** In my program have a printer settings program that allows users to
*** configure the program for a specific printer. The settings are saved
*** in Printer.Mem.
*** Note that in the SET PRINTER TO command PRNBAUD is not a macro. Don't
*** know why.
if MMAC
   if .not. file('PRINTER.MEM')
      PRNPORT='COM2'              && Imagewriter defaults
      PRNBAUD=9600                && adjust these defaults for your printer
      PRNPARITY='N'
      PRNDATA='8'
      PRNSTOP='1'
      PRNHAND='H'
      PRNEND='RL'
      PRNCH10='N'                 && escape sequence for 10 chars/inch
      PRN6LINE='A'                && escape sequence for 6 lines/inch
      PRNCH17='Q'                 && escape sequence for 17 chars/inch
      save all like PRN* to 'PRINTER.MEM'
   else
      restore from 'PRINTER.MEM' additive
   endif
   set printer to &PRNPORT,PRNBAUD,&PRNPARITY,&PRNDATA,&PRNSTOP,&PRNHAND,&PRNEND
   release all like PRN*
endif

*** Handling color for PC's and Mac's
*** Note: ISCOLOR() will return True on some monochrome monitors.
if iscolor()
   if .not. MMAC
      *** pc colors here
      CCLTITLE='BG+/N,N/BG+'
      CCLBOX='GR+/N,N/GR+'
      CCLTEXT='W+/N,N/W+'
      CCLWARN='R+/N,N/R+'
      CCLGET='W/N,N/W'
      CCLMENU='BG+/N,N/W'
   else
      *** mac colors here
      CCLTITLE=''
      CCLBOX=''
      CCLTEXT=''
      CCLWARN=''
      CCLGET=''
      CCLMENU=''
   endif
else
   CCLTITLE=''
   CCLBOX=''
   CCLTEXT=''
   CCLWARN=''
   CCLGET=''
   CCLMENU=''
endif

*** Wait string: nice for Mac since all it says by default is "Waiting"
if MMAC
   WWTEXT='Press any key to continue'
else
   WWTEXT=''
endif

*** if you have your own help routines (haven't converted over to the Mac way)
*** and want to emulate the way it works in DOS
if MMAC
   set help off                   && <-this disables help in the Apple menu
                                  && otherwise, users will get Fox help
   on key=240 do help             && <-doesn't work for Mac plus (nothing does)
                                  && or for machines that emulate function keys
                                  && by pressing Command #. But I don't know
                                  && how you know what's available on a
                                  && particular machine.
else
   on key=315 do help
endif

if file('function.mem')
   restore from FUNCTION.MEM additive
else
   store ' ' to X2,X3,X4,X5,X6,X7,X8,X9,X10
endif
set function 2 to X2
set function 3 to X3
set function 4 to X4
set function 5 to X5
set function 6 to X6
set function 7 to X7
set function 8 to X8
set function 9 to X9
set function 10 to X10

*** if you use @...PROMPT style menus, Mac users have an additional selection
*** option -- they can point with the mouse and double click on their choice
*** as well as move the bar and press <RETURN> or type the option letter
if MMAC
   store "     DOUBLE CLICK, MOVE BAR OR TYPE LETTER TO SELECT" to MMESSAGE
else
   store "CHOOSE AN OPTION BY MOVING BAR OR ENTERING OPTION LETTER" to MMESSAGE
endif

*** I was hoping to find a way to replace the "About FoxBASE+' message
*** that normally shows up in the Apple menu with an "About Your Program
*** message. Unfortunately, can't seem to do it in a program that doesn't
*** use Mac's ON MENU command (and we're trying to avoid that in a basic
*** conversion) without weird things happening.
*** However it is possible to make the "About FoxBASE" message disappear.
if MMAC
   dimension MENUBAR(1)                     && for real fun, store '' to aabout
   MENUBAR(1)=' '                           && this completely disables the
   menu bar MENUBAR                         && Apple menu until you quit Foxbase
   menu off 1
   store '   ' to AABOUT
   menu -2, AABOUT
   on menu
endif
*** if you want to see how it works to try an "About Your Program" change
*** the code above as follows:
*** STORE "ABOUT YOUR PROGRAM" TO AABOUT
*** ON MENU DO ABOUT (procedure included at bottom of this .prg)
*** While at the main menu, choose this option. Nothing happens, but as soon
*** as you select an option (try screen examples), it pops up. There are other
*** weird things -- it doesn't work when you're sitting at any kind of menu
*** and it has odd effects on the other procedures. I'm sure this has to do
*** with my totally not understanding something.

*** fancy intro designed with Mac screen painter
if MMAC
   clear
   screen 5 type 1  at 0,0 size 197,385 pixels  font "Geneva",12 color 0,0,0,-1,-1,-1 top
   @ pixels 45,106 say "Fancy Intro" style 65536 font "New York",24 color 0,0,0,-1,-1,-1
   @ pixels 81,88 say "Just to Show You What's Possible" style 65536 font "Chicago",12 color 0,0,0,-1,-1,-1
   @ pixels 117,109 say "(c) 1990 Nancy Jacobsen" style 65536 font "Geneva",12 color 0,0,0,-1,-1,-1
   @ pixels 133,85 say "Just Fooling Around, Enterprises" style 65536 font "Geneva",12 color 0,0,0,-1,-1,-1
   wait WWTEXT
   screen 5 off
   screen 5 delete
   screen 1 top lock
endif

*** main program loop
do while .t.
   clear
   close databases
   set color to &CCLBOX
   @ 4,10 to 4,69 double
   @ 12,10 to 12,69 double
   @ 1,9 to 14,69 double
   @ 4, 9 say iif(MMAC,'',chr(204))
   @ 4, 69 say iif(MMAC,'',chr(185))
   @ 12, 9 say iif(MMAC,'',chr(204))
   @ 12, 69 say iif(MMAC,'',chr(185))
   set color to &CCLTITLE
   @ 2, 35 say "PC TO MAC"
   @ 3, 35 say "MAIN MENU"
   @ 13, 11 say MMESSAGE
   set color to &CCLTEXT
   @ 6, 28 prompt "A. SCREEN EXAMPLES     "
   @ 7, 28 prompt "B. MENU EXAMPLES       "
   @ 8, 28 prompt "C. PRINTING EXAMPLES   "
   @ 9, 28 prompt "Q. QUIT                "
   @ 10, 28 prompt "?. HELP                "
   clear typeahead
   menu to CHOICE
   do case
   case CHOICE= 1
      do BOXPROG
   case CHOICE= 2
      do MENUPROG
   case CHOICE= 3
      do PRINPROG
   case CHOICE= 4
      if MMAC
         clear
         ALERT CAUTION 3 to WWHAT "Wow! Is this Mac or what? Do you really want to quit?"
         if WWHAT=1
            cancel
         endif
      else
         WWHAT='Y'
         set color to &CCLWARN
         @ 13,11 clear to 13,68
         @ 13,20 say "DO YOU REALLY WANT TO QUIT? (Y/N) "
         set color to &CCLGET
         @ row(),col() get WWHAT picture '!' valid WWHAT$'YN'
         read
         if WWHAT='Y'
            clear
            cancel
         endif
      endif
   case CHOICE= 5
      do help
   endcase
enddo .T.


**************************************************************************
*** BOXPROG.PRG
*** demonstrates the differences between PC screen painting techniques
*** and Mac screen techniques
**************************************************************************
procedure BOXPROG

*** the following code is original DOS code
set color to &CCLBOX
clear
@ 10,5 say 'THE FOLLOWING THREE SCREENS ARE IN UNCHANGED DOS CODE'
wait

clear
set color to &CCLBOX
@  3, 0 to 12,79 double
@ 12, 0 to 14,79 double
@ 13,40 to 14,40 double
@ 12, 0 say "Ã"
@ 12,79 say "π"
@ 12,40 say "À"
@ 14,40 say " "
set color to &CCLTEXT
@  5, 4 say "This is an example of a screen created in Foxview, using the DOUBLE"
@  6, 4 say "command for box generation and a variety of extended characters."
@  8, 4 say " This character for example."
@  9, 4 say " And this one."
@ 11, 4 say "Plus connecting characters like Ã, π,  , and À."
@ 23, 0
wait WWTEXT

clear
set color to &CCLBOX
@  3, 0,12,79 box "…Õª∫ºÕ»∫"
@ 12, 0,14,79 box "…Õª∫ºÕ»∫"
@ 13,40,14,40 box "…Õª∫ºÕ»∫"
@ 12, 0 say "Ã"
@ 12,79 say "π"
@ 12,40 say "À"
@ 14,40 say " "
set color to &CCLTEXT
@  5, 4 say "This is an example of a screen created in Foxview, using the BOX"
@  6, 4 say "command for box generation and a variety of extended characters."
@  8, 4 say " This character for example."
@  9, 4 say " And this one."
@ 11, 4 say "Plus connecting characters like Ã, π,  , and À."
@ 23, 0
wait WWTEXT

clear
set color to &CCLBOX
@  2, 8 say "…ÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕª"
@  3, 8 say "∫                                                          ∫"
@  4, 8 say "∫                                                          ∫"
@  5, 8 say "∫   This box was created by appending a text file into     ∫"
@  6, 8 say "∫   Foxview without further manipulation of boxes.         ∫"
@  7, 8 say "∫                                                          ∫"
@  8, 8 say "∫                                                          ∫"
@  9, 8 say "ÃÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕπ"
@ 10, 8 say "∫  CHOOSE OPTION BY MOVING BAR OR ENTERING OPTION LETTER   ∫"
@ 11, 8 say "»ÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕÕº"
@ 23, 0
wait WWTEXT

*** the following code has been changed to accommodate the Mac and to run
*** properly on either machine
clear
set color to &CCLBOX
@ 10,5 say 'THE FOLLOWING THREE SCREENS ARE IN DOS CODE MODIFIED FOR THE MAC'
wait WWTEXT

clear
set color to &CCLBOX
@  3, 0 to 12,79 double
@ 12, 0 to 14,79 double
if MMAC
   @ 12,40,14,40 box
else
   @ 13,40 to 14,40 double
endif
@ 12, 0 say iif(MMAC,'',chr(204))
@ 12,79 say iif(MMAC,'',chr(185))
@ 12,40 say iif(MMAC,'',chr(203))
@ 14,40 say iif(MMAC,'',chr(202))
set color to &CCLTEXT
@  5, 4 say "This is an example of a screen created in Foxview, using the DOUBLE"
@  6, 4 say "command for double box generation and a variety of extended characters."
@  8, 4 say iif(MMAC,chr(198),chr(16))+" This character for example."
@  9, 4 say iif(MMAC,chr(165),chr(17))+" And this one."
if .not. MMAC
   @ 11, 4 say "Plus connecting characters like Ã, π,  , and À."
endif
@ 23, 0
wait WWTEXT

clear
set color to &CCLBOX
@  3, 0,12,79 box "…Õª∫ºÕ»∫"
@ 12, 0,14,79 box "…Õª∫ºÕ»∫"
@ 12,40,14,40 box "…Õª∫ºÕ»∫"
@ 12, 0 say iif(MMAC,'',chr(204))
@ 12,79 say iif(MMAC,'',chr(185))
@ 12,40 say iif(MMAC,'',chr(203))
@ 14,40 say iif(MMAC,'',chr(202))
set color to &CCLTEXT
@  5, 4 say "This is an example of a screen created in Foxview, using the BOX"
@  6, 4 say "command for double box generation and a variety of extended characters."
@  8, 4 say iif(MMAC,chr(198),chr(16))+" This character for example."
@  9, 4 say iif(MMAC,chr(165),chr(17))+" And this one."
if .not. MMAC
   @ 11, 4 say "Plus connecting characters like Ã, π,  , and À."
endif
@ 23, 0
wait WWTEXT

clear
set color to &CCLBOX
@  2, 8 to 11,67 double
@  9, 8 to 11,67 double
@  9, 8 say iif(MMAC,'',chr(204))
@  9,67 say iif(MMAC,'',chr(185))
set color to &CCLTEXT
@  5, 9 say "   This box was created by appending a text file into     "
@  6, 9 say "   Foxview without further manipulation of boxes.         "
@ 10, 9 say "  CHOOSE OPTION BY MOVING BAR OR ENTERING OPTION LETTER  "
@ 23, 0
wait WWTEXT
return

******************************************************************************
*** MENUPROG.PRG
*** controls display of menu examples
******************************************************************************
procedure MENUPROG
private CCHOICES,MCHOICE

clear
set color to &CCLBOX
@ 7,5 say '@...MENU / READ MENU TO'
@ 8,5 say '======================='
set color to &CCLTEXT
@ 10,5 say 'THE FIRST MENU EXAMPLE YOU WILL SEE IS A "@...MENU / READ MENU TO"'
@ 11,5 say 'TYPE MENU. WHEN YOU RUN IT ON A PC, YOU WILL GET DIFFERENT RESULTS THAN'
@ 12,5 say 'WHEN YOU RUN IT ON A MAC.'
@ 23,0
wait

clear
set color to &CCLMENU
dimension CCHOICES(3,1)
CCHOICES(1)='1ST CHOICE'
CCHOICES(2)='2ND CHOICE'
CCHOICES(3)='3RD CHOICE'
MCHOICE=1
@ 10,5 menu CCHOICES,3 title "SAMPLE MENU"
read menu to MCHOICE
do case
case MCHOICE=1
   @ 16,5 say "You have chosen choice number 1"
case MCHOICE=2
   @ 16,5 say "You have chosen choice number 2"
case MCHOICE=3
   @ 16,5 say "You have chosen choice number 3"
endcase
@ 23,0
wait

clear
set color to &CCLBOX
@ 7,5 say "READ MENU BAR TO"
@ 8,5 say '================'
set color to &CCLTEXT
@ 10,5 say 'THE FOLLOWING SAMPLE MENUS WERE TAKEN FROM AN ACTUAL PROGRAM'
@ 11,5 say 'AND THEY REPRESENT SOME EXAMPLES OF THE DIFFICULTIES FACED WHEN'
@ 12,5 say 'PORTING THE "READ BAR MENU TO" TYPE OF MENU TO A MAC'
@ 23,0
wait

clear
set color to &CCLBOX
@ 7,5 say "READ MENU BAR TO"
@ 8,5 say '================'
set color to &CCLTEXT
@ 10,5 say 'IF YOU ARE RUNNING THIS PROGRAM ON A PC, THE NEXT MENU YOU WILL SEE'
@ 11,5 say 'IS A STRAIGHT PC "READ MENU BAR TO" MENU'
@ 13,5 say "IF YOU ARE RUNNING THIS PROGRAM ON A MAC, THE NEXT MENU YOU WILL SEE"
@ 14,5 say "IS A DIRECT PORT OF THE PC MENU"
@ 23,0
wait

if .not. MMAC
   do D390MASM
   set color to &CCLTEXT
   clear
   @ 10,5 say 'NO FURTHER MENUS IN THIS DEMO RUN ON THE PC'
   @ 23,0
   wait
   return
endif

clear
set color to &CCLBOX
@ 7,5 say "READ MENU BAR TO"
@ 8,5 say '================'
set color to &CCLTEXT
@ 10,5 say 'THE FOLLOWING MENU ONLY RUNS ON A MAC'
@ 12,5 say "WITH A FEW EXCEPTIONS, IT'S A DIRECT PORT OF THE PC CODE"
@ 14,5 say 'THE MAJOR PROBLEM WITH THIS MENU IS THAT ALL THE PC OPTIONS ON THE TOP BAR'
@ 15,5 say 'DO NOT FIT ON A SMALL MAC SCREEN. IN THIS CASE IT MEANS THAT QUIT IS NO'
@ 16,5 say 'NO LONGER ACCESSIBLE. SO FOR PURPOSES OF THIS DEMO, PRESS COMMAND Q'
@ 17,5 say 'OR CHOOSE ITEM 1 FROM THE "ACCT" MENU TO QUIT.'
@ 19,5 say "OTHER PROBLEMS ARE THAT MENU CHOICES DON'T LOOK GOOD IN UPPER CASE,"
@ 20,5 say "AND THE MENU STILL APPEARS AFTER A CHOICE HAS BEEN MADE. TRY CHOICES "
@ 21,5 say '"ADD AN ACCOUNT" AND "CHANGE AN ACCOUNT" TO SEE WHAT HAPPENS '
@ 22,5 say 'WHEN A CHOICE IS MADE'
@ 23,0
wait

if MMAC
   do D390MAS2
endif

clear
set color to &CCLBOX
@ 7,5 say "READ MENU BAR TO"
@ 8,5 say '================'
set color to &CCLTEXT
@ 10,5 say 'THE FOLLOWING MENU ONLY RUNS ON A MAC'
@ 12,5 say 'THIS IS THE SAME MENU CHANGED AND GUSSIED UP FOR THE MAC'
@ 14,5 say 'NOTICE THAT MORE OPTIONS ARE AVAILABLE, THE MENU IS DISABLED AFTER '
@ 15,5 say 'A CHOICE. '
@ 17,5 say 'TRY CHOICES "ADD AN ACCOUNT" AND "CHANGE AN ACCOUNT" TO SEE WHAT'
@ 18,5 say 'HAPPENS WHEN A CHOICE IS MADE'
@ 20,5 say 'PRESS COMMAND Q OR SELECT FROM QT MENU TO QUIT'
@ 23,0
wait

if MMAC
   do D390MAS3
endif

return


******************************************************************************
*** D390MASM.PRG
*** sample "read menu to " -- runs only on PC
******************************************************************************
procedure D390MASM

dimension AZXTOP(11,2)
AZXTOP(1,1)='ACCT '
AZXTOP(2,1)='CONT '
AZXTOP(3,1)=' ADS '
AZXTOP(4,1)='CASH '
AZXTOP(5,1)='CLOS '
AZXTOP(6,1)='ACTG '
AZXTOP(7,1)='CODE '
AZXTOP(8,1)='SYSP '
AZXTOP(9,1)='UTIL '
AZXTOP(11,1)='QUIT '
AZXTOP(10,1)='HELP '
AZXTOP(1,2)='ACCOUNT MAINTENANCE'
AZXTOP(2,2)='CONTRACT MAINTENANCE'
AZXTOP(3,2)='AD MAINTENANCE AND SCHEDULING'
AZXTOP(4,2)='CASH RECEIPTS AND OTHER TRANSACTIONS'
AZXTOP(5,2)='CLOSE ISSUE / ACCOUNTING PERIODS'
AZXTOP(6,2)='ACCOUNTING REPORTS AND PROCEDURES'
AZXTOP(7,2)='CODE FILE MAINTENANCE'
AZXTOP(8,2)='SYSTEM PARAMETERS'
AZXTOP(9,2)='UTILITIES'
AZXTOP(11,2)='QUIT TO MAIN MENU'
AZXTOP(10,2)='HELP'

dimension ACCT(12)
ACCT(1)='A. MENU'
ACCT(2)='B. ADD AN ACCOUNT'
ACCT(3)='C. CHANGE AN ACCOUNT'
ACCT(4)='D. DELETE AN ACCOUNT'
ACCT(5)='E. LIST ACCOUNTS'
ACCT(6)='F. MASTER LIST'
ACCT(7)='G. DATA SHEETS-ONE'
ACCT(8)='H. DATA SHEETS-MULTIPLE'
ACCT(9)='I. LABELS-VARIOUS'
ACCT(10)='J. LABELS-BY ISSUE'
ACCT(11)='K. LAST ACTIVITY AGING'
ACCT(12)='L. TICKLER FILE'

dimension CTRC(9)
CTRC(1)='A. MENU'
CTRC(2)='B. ADD A CONTRACT'
CTRC(3)='C. CHANGE A CONTRACT'
CTRC(4)='D. DELETE A CONTRACT'
CTRC(5)='E. PRINT LONG FORM REPORTS'
CTRC(6)='F. DISPLAY/PRINT SHORT FORM REPORTS 1'
CTRC(7)='G. DISPLAY/PRINT SHORT FORM REPORTS 2'
CTRC(8)='H. DISPLAY/PRINT ADS SCHEDULED REPORT'
CTRC(9)='I. CONTRACT HISTORY REPORTS/PURGE'

dimension AD(13)
AD(1)='A. MENU'
AD(2)='B. ADD AD - COLUMN/INCH'
AD(3)='C. CHANGE AD - COLUMN/INCH'
AD(4)='D. ADD TRANSACTION - COL/INCH'
AD(5)='E. ADD AD - RATE CHART'
AD(6)='F. CHANGE AD - RATE CHART'
AD(7)='G. ADD TRANSACTION - RATE CHART'
AD(8)='H. DELETE AN AD/TRANSACTION'
AD(9)='I. SCHEDULE ADS'
AD(10)='J. RUNSHEET'
AD(11)='K. ADS IN SYSTEM REPORT'
AD(12)='L. ADS FOR AN ACCOUNT REPORT'
AD(13)='M. RATE CHART MAINTENANCE'

dimension CASH(7)
CASH(1)='A. MENU'
CASH(2)='B. ADD A TRANSACTION'
CASH(3)='C. CHANGE A TRANSACTION'
CASH(4)='D. DELETE A TRANSACTION'
CASH(5)='E. LIST TRANSACTIONS'
CASH(6)='F. POST TRANSACTIONS'
CASH(7)='G. REPRINT POSTING REPORTS'

dimension CLOX(1)
CLOX(1)='A. MENU'

dimension ATG(10)
ATG(1)='A. MENU'
ATG(2)='B. AGING REPORTS'
ATG(3)='C. AGE ACCOUNTS RECEIVABLE'
ATG(4)='D. SERVICE CHARGE ASSESSMENT'
ATG(5)='E. STATEMENTS AND INVOICES'
ATG(6)='F. REMINDER NOTICES'
ATG(7)='G. LEDGERS - PRINT/PURGE'
ATG(8)='H. GL DISTRIBUTION - PRINT PURGE'
ATG(9)='I. SALES ANALYSIS REPORTS'
ATG(10)='J. SALES ANALYSIS REPORTS - CONSOLIDATED'

dimension CF(6)
CF(1)='A. MENU'
CF(2)='B. GL NUMBERS'
CF(3)='C. TRANSACTION CODES'
CF(4)='D. SALESPERSON CODES'
CF(5)='E. SECTION CODES'
CF(6)='F. ACCOUNT TYPE CODES'

dimension SY(1)
SY(1)='A. MENU'

dimension UT(11)
UT(1)='A. MENU'
UT(2)='B. BALANCE FORWARD'
UT(3)='C. REINDEX'
UT(4)='D. BALANCE CHECK'
UT(5)='E. CHANGE SALESPERSON CODES'
UT(6)='F. DIAGNOSTIC REPORT'
UT(7)='G. CHANGE SYSTEM DATE'
UT(8)='H. RUN DOS COMMANDS'
UT(9)='I. FUNCTION KEYS ASSIGNMENT'
UT(10)='J. CHANGE ACCOUNT CODES'
UT(11)='K. USER CHECK'

dimension HLP(9)
HLP(1)='A. ACCOUNTS'
HLP(2)='B. CONTRACTS'
HLP(3)='C. ADS/SCHEDULING'
HLP(4)='D. CASH/TRANSACTIONS'
HLP(5)='E. CLOSE ISSUE/PERIODS'
HLP(6)='F. ACCOUNTING'
HLP(7)='G. FILE MAINTENANCE'
HLP(8)='H. SYSTEM PARAMETERS'
HLP(9)='I. UTILITIES'

dimension QT(1)
QT(1)='Q. QUIT TO MAIN MENU'
AXZROW=1
AXZCOL=1
do while .t.
   set color to &CCLMENU
   clear
   close databases
   menu bar AZXTOP,11
   menu 1,ACCT,12,12
   menu 2,CTRC,9,9
   menu 3,AD,13,13
   menu 4,CASH,7,7
   menu 5,CLOX,1,1
   menu 6,ATG,10,10
   menu 7,CF,6,6
   menu 8,SY,1,1
   menu 9,UT,11,11
   menu 10,HLP,9,9
   menu 11,QT,1,1
   read menu bar to AXZCOL, AXZROW save
   do case
   case AXZCOL=11 .and. AXZROW=1
      close data
      return
   endcase
enddo

******************************************************************************
*** D390MAS2.PRG
*** port of d390masm to a mac
******************************************************************************
procedure D390MAS2

dimension AZXTOP(11,2)
AZXTOP(1,1)='ACCT '
AZXTOP(2,1)='CONT '
AZXTOP(3,1)=' ADS '
AZXTOP(4,1)='CASH '
AZXTOP(5,1)='CLOS '
AZXTOP(6,1)='ACTG '
AZXTOP(7,1)='CODE '
AZXTOP(8,1)='SYSP '
AZXTOP(9,1)='UTIL '
AZXTOP(11,1)='QUIT '
AZXTOP(10,1)='HELP '

*** the following items won't show up
AZXTOP(1,2)='ACCOUNT MAINTENANCE'
AZXTOP(2,2)='CONTRACT MAINTENANCE'
AZXTOP(3,2)='AD MAINTENANCE AND SCHEDULING'
AZXTOP(4,2)='CASH RECEIPTS AND OTHER TRANSACTIONS'
AZXTOP(5,2)='CLOSE ISSUE / ACCOUNTING PERIODS'
AZXTOP(6,2)='ACCOUNTING REPORTS AND PROCEDURES'
AZXTOP(7,2)='CODE FILE MAINTENANCE'
AZXTOP(8,2)='SYSTEM PARAMETERS'
AZXTOP(9,2)='UTILITIES'
AZXTOP(11,2)='QUIT TO MAIN MENU'
AZXTOP(10,2)='HELP'

dimension ACCT(12)
ACCT(1)='Q. MENU/Q'
ACCT(2)='B. ADD AN ACCOUNT'
ACCT(3)='C. CHANGE AN ACCOUNT'
ACCT(4)='D. DELETE AN ACCOUNT'
ACCT(5)='E. LIST ACCOUNTS'
ACCT(6)='F. MASTER LIST'
ACCT(7)='G. DATA SHEETS-ONE'
ACCT(8)='H. DATA SHEETS-MULTIPLE'
ACCT(9)='I. LABELS-VARIOUS'
ACCT(10)='J. LABELS-BY ISSUE'
ACCT(11)='K. LAST ACTIVITY AGING'
ACCT(12)='L. TICKLER FILE'

dimension CTRC(9)
CTRC(1)='A. MENU'
CTRC(2)='B. ADD A CONTRACT'
CTRC(3)='C. CHANGE A CONTRACT'
CTRC(4)='D. DELETE A CONTRACT'
CTRC(5)='E. PRINT LONG FORM REPORTS'
CTRC(6)='F. DISPLAY/PRINT SHORT FORM REPORTS 1'
CTRC(7)='G. DISPLAY/PRINT SHORT FORM REPORTS 2'
CTRC(8)='H. DISPLAY/PRINT ADS SCHEDULED REPORT'
CTRC(9)='I. CONTRACT HISTORY REPORTS/PURGE'

dimension AD(13)
AD(1)='A. MENU'
AD(2)='B. ADD AD - COLUMN/INCH'
AD(3)='C. CHANGE AD - COLUMN/INCH'
AD(4)='D. ADD TRANSACTION - COL/INCH'
AD(5)='E. ADD AD - RATE CHART'
AD(6)='F. CHANGE AD - RATE CHART'
AD(7)='G. ADD TRANSACTION - RATE CHART'
AD(8)='H. DELETE AN AD/TRANSACTION'
AD(9)='I. SCHEDULE ADS'
AD(10)='J. RUNSHEET'
AD(11)='K. ADS IN SYSTEM REPORT'
AD(12)='L. ADS FOR AN ACCOUNT REPORT'
AD(13)='M. RATE CHART MAINTENANCE'

dimension CASH(7)
CASH(1)='A. MENU'
CASH(2)='B. ADD A TRANSACTION'
CASH(3)='C. CHANGE A TRANSACTION'
CASH(4)='D. DELETE A TRANSACTION'
CASH(5)='E. LIST TRANSACTIONS'
CASH(6)='F. POST TRANSACTIONS'
CASH(7)='G. REPRINT POSTING REPORTS'

dimension CLOX(1)
CLOX(1)='A. MENU'

dimension ATG(10)
ATG(1)='A. MENU'
ATG(2)='B. AGING REPORTS'
ATG(3)='C. AGE ACCOUNTS RECEIVABLE'
ATG(4)='D. SERVICE CHARGE ASSESSMENT'
ATG(5)='E. STATEMENTS AND INVOICES'
ATG(6)='F. REMINDER NOTICES'
ATG(7)='G. LEDGERS - PRINT/PURGE'
ATG(8)='H. GL DISTRIBUTION - PRINT PURGE'
ATG(9)='I. SALES ANALYSIS REPORTS'
ATG(10)='J. SALES ANALYSIS REPORTS - CONSOLIDATED'

dimension CF(6)
CF(1)='A. MENU'
CF(2)='B. GL NUMBERS'
CF(3)='C. TRANSACTION CODES'
CF(4)='D. SALESPERSON CODES'
CF(5)='E. SECTION CODES'
CF(6)='F. ACCOUNT TYPE CODES'

dimension SY(1)
SY(1)='A. MENU'

dimension UT(11)
UT(1)='A. MENU'
UT(2)='B. BALANCE FORWARD'
UT(3)='C. REINDEX'
UT(4)='D. BALANCE CHECK'
UT(5)='E. CHANGE SALESPERSON CODES'
UT(6)='F. DIAGNOSTIC REPORT'
UT(7)='G. CHANGE SYSTEM DATE'
UT(8)='H. RUN DOS COMMANDS'
UT(9)='I. FUNCTION KEYS ASSIGNMENT'
UT(10)='J. CHANGE ACCOUNT CODES'
UT(11)='K. USER CHECK'

dimension HLP(9)                         && this choice does not show up
HLP(1)='A. ACCOUNTS'
HLP(2)='B. CONTRACTS'
HLP(3)='C. ADS/SCHEDULING'
HLP(4)='D. CASH/TRANSACTIONS'
HLP(5)='E. CLOSE ISSUE/PERIODS'
HLP(6)='F. ACCOUNTING'
HLP(7)='G. FILE MAINTENANCE'
HLP(8)='H. SYSTEM PARAMETERS'
HLP(9)='I. UTILITIES'

dimension QT(1)                         && this choice does not show up
QT(1)='Q. QUIT TO MAIN MENU'
AXZROW=1
AXZCOL=1
do while .t.
   set color to &CCLMENU
   clear
   @ 15,28 say "Press Command Q to Quit"
   close databases
   menu bar AZXTOP,11
   menu 1,ACCT,12,12
   menu 2,CTRC,9,9
   menu 3,AD,13,13
   menu 4,CASH,7,7
   menu 5,CLOX,1,1
   menu 6,ATG,10,10
   menu 7,CF,6,6
   menu 8,SY,1,1
   menu 9,UT,11,11
   menu 10,HLP,9,9
   menu 11,QT,1,1
   read menu bar to AXZCOL, AXZROW save
   do case
   case AXZCOL=1  .and. AXZROW=1
      close data
      return
   case AXZCOL=11 .and. AXZROW=1   && doesn't work -- not available on menu
      close data
      return
   case AXZCOL=1  .and. AXZROW=2
      do BOXPROG
   case AXZCOL=1  .and. AXZROW=3
      do help
   endcase
enddo

******************************************************************************
*** D390MAS3.PRG
*** port of d390masm to a mac -- GUSSIED UP
******************************************************************************
procedure D390MAS3

*** Since the Mac menu bar always includes the Apple menu, the File menu and
*** the Edit menu, you may not be able to include as many options as you can
*** with DOS READ MENU BAR TO as has happened here.

*** When translated to the Mac, upper case letters no longer look good in
*** the font that FoxBASE+/Mac uses for this kind of menu. Indeed they take
*** up a lot of space. You can actually get another menu bar option or two
*** simply by changing menu options to capitalized/lower case.

*** The Mac menus allow all sorts of fancy formatting, separating lines, and
*** the installation of keyboard shortcut keys. This program has examples
*** of all these. See the ON MENU command for how to do this.

*** The menu is no longer "sticky" -- it won't stay down, but must be pulled
*** down. A return to the menu does not take it back to where it was -- the
*** choice must be made by clicking and pulling all over again.
*** While on the PC, you could select an option from the drop down menu by
*** pressing the first letter of an option -- that doesn't work any more. You
*** have to make do with "keyboard shortcuts." Unfortunately, there aren't as
*** many available keys because each keyboard shortcut letter can only have
*** one purpose on the entire menu -- not depending on which menu you're in.
*** Since the "/" now denotes a hot key or keyboard shortcut, these characters
*** must be removed from any existing choices.

*** After a choice is made, the menu at the top is grayed out. A user can still
*** see what the options are -- they'll just be gray.

*** One nice thing about this menu on the Mac is that you can put in comments
*** on the screen -- an example is included here.

*** DIFFERENCES BETWEEN THIS AND "ON MENU"
*** ON MENU is very similar but it's intent is to allow event drive programming
*** while this menu type does not.
*** In ON MENU, options can be defined as either arrays or character strings."
*** For example, the "acct" array variable defined in this code could be
*** programmed as:
*** STORE "<BMenu/A;Add an Account;Change an Account;Delete an Account;List Accounts;Master List" TO ACCT
*** STORE ACCT+";Data Sheets - One;Data Sheets - Multiple;Labels - Various;Labels - By Issue;" TO ACCT
*** STORE ACCT+"Last Activity Aging;Tickler File" TO ACCT
*** Character strings or arrays can both be used in the same code.
*** The trouble with character strings is that if there are a lot of
*** options and/or options with long names, the end may get truncated --
*** no error message, just not there.

dimension AZXTOP(11,2)
AZXTOP(1,1)='Acct'       && Mix of upper and lower case allows more options
AZXTOP(2,1)='Cont'       && per menu bar -- still not as many as DOS
AZXTOP(3,1)='Ads'
AZXTOP(4,1)='Cash'
AZXTOP(5,1)='Clos'
AZXTOP(6,1)='Actg'
AZXTOP(7,1)='Code'
AZXTOP(8,1)='Sys'
AZXTOP(9,1)='Util'
AZXTOP(10,1)='Qt'        && by reducing to 2 characters, can now get on menu
*azxtop(11,1)='Help'     && no room for this -- eliminate for now

*** The messages that normally display on the screen on the PC with this type
*** menu do not display on the Mac. The following code could be eliminated.
AZXTOP(1,2)='Account Maintenance'
AZXTOP(2,2)='Contract Maintenance'
AZXTOP(3,2)='Ad Maintenance and Scheduling'
AZXTOP(4,2)='Cash Receipts and Other Transactions'
AZXTOP(5,2)='Close Issue : Accounting Periods'
AZXTOP(6,2)='Accounting Reports and Procedures'
AZXTOP(7,2)='Code File Maintenance'
AZXTOP(8,2)='System Parameters'
AZXTOP(9,2)='Utilities'
AZXTOP(11,2)='Quit to Main Menu'
AZXTOP(10,2)='Help'

dimension ACCT(13)
ACCT(1)='<BMenu/A'              && note that "<B" will bold face choice
ACCT(2)='Add an account'        && "/A" creates a keyboard shortcut
ACCT(3)='Change an account'     && note that initial letters have been
ACCT(4)='Delete an account'     && removed since they didn't work anyway
ACCT(5)='(-'                    && <-add a line, counts as a variable
ACCT(6)='List accounts'
ACCT(7)='Master list'
ACCT(8)='Data sheets-one'
ACCT(9)='Data sheets-multiple'
ACCT(10)='Labels-various'
ACCT(11)='Labels-by issue'
ACCT(12)='Last activity aging'
ACCT(13)='Tickler file'

dimension CTRC(9)
CTRC(1)='<BMenu/C'
CTRC(2)='Add a contract'
CTRC(3)='Change a contract'
CTRC(4)='Delete a contract'
CTRC(5)='Print long form reports'
CTRC(6)='Display:print short form reports 1' && "/" replaced by colon
CTRC(7)='Display:print short form reports 2'
CTRC(8)='Display:print ads scheduled report'
CTRC(9)='Contract history reports:purge'

dimension AD(13)
AD(1)='<BMenu/D'
AD(2)='Add ad - column:inch'
AD(3)='Change ad - column:inch'
AD(4)='Add transaction - col:inch'
AD(5)='Add ad - rate chart'
AD(6)='Change ad - rate chart'
AD(7)='Add transaction - rate chart'
AD(8)='Delete an ad:transaction'
AD(9)='Schedule ads'
AD(10)='Runsheet'
AD(11)='Ads in system report'
AD(12)='Ads for an account report'
AD(13)='Rate chart maintenance'

dimension CASH(7)
CASH(1)='<BMenu/T'
CASH(2)='Add a transaction'
CASH(3)='Change a transaction'
CASH(4)='Delete a transaction'
CASH(5)='List transactions'
CASH(6)='Post transactions'
CASH(7)='Reprint posting reports'

dimension CLOX(1)
CLOX(1)='<BMenu/I'

dimension ATG(10)
ATG(1)='<BMenu/G'
ATG(2)='Aging reports'
ATG(3)='Age accounts receivable'
ATG(4)='Service charge assessment'
ATG(5)='Statements and invoices'
ATG(6)='Reminder notices'
ATG(7)='Ledgers - print:purge'
ATG(8)='Gl distribution - print purge'
ATG(9)='Sales analysis reports'
ATG(10)='Sales analysis reports - consolidated'

dimension CF(6)
CF(1)='<BMenu/F'
CF(2)='Gl numbers'
CF(3)='Transaction codes'
CF(4)='Salesperson codes'
CF(5)='Section codes'
CF(6)='Account type codes'

dimension SY(1)
SY(1)='<BMenu/S'

dimension UT(11)
UT(1)='<BMenu/U'
UT(2)='Balance forward'
UT(3)='Reindex'
UT(4)='Balance check'
UT(5)='Change salesperson codes'
UT(6)='Diagnostic report'
UT(7)='Change system date'
UT(8)='Run dos commands'
UT(9)='Function keys assignment'
UT(10)='Change account codes'
UT(11)='User check'

dimension HLP(9)                         && no longer available on menu
HLP(1)='A. Accounts'
HLP(2)='B. Contracts'
HLP(3)='C. Ads:scheduling'
HLP(4)='D. Cash:transactions'
HLP(5)='E. Close issue:periods'
HLP(6)='F. Accounting'
HLP(7)='G. File maintenance'
HLP(8)='H. System parameters'
HLP(9)='I. Utilities'

dimension QT(1)
QT(1)='<BQuit to main menu/Q'
AXZROW=1
AXZCOL=1
do while .t.
   set color to &CCLMENU
   clear

   *** You can stick an informative message on the screen.
   *** The following message was designed using the Mac screen painter.
   @ PIXELS 12,208 say "Master Menu" style 65536 FONT "Chicago",12 color 0,0,0,-1,-1,-1
   @ PIXELS 34,62 say "Select Options with Mouse from Above Pull Down Menu" style 65536 FONT "Chicago",12 color 0,0,0,-1,-1,-1
   @ PIXELS 61,12 say "Acct - Command A - Account Maintenance and Reports" style 65536 FONT "Monaco",12 color 0,0,0,-1,-1,-1
   @ PIXELS 77,12 say "Cont - Command C - Contract Maintenance" style 65536 FONT "Monaco",12 color 0,0,0,-1,-1,-1
   @ PIXELS 93,12 say "Ads  - Command D - Ad Maintenance, Scheduling, Runsheet & Ratechart" style 65536 FONT "Monaco",12 color 0,0,0,-1,-1,-1
   @ PIXELS 109,12 say "Cash - Command T - Cash Receipts and Other Transactions" style 65536 FONT "Monaco",12 color 0,0,0,-1,-1,-1
   @ PIXELS 125,12 say "Actg - Command G - Accounting Reports and Procedures " style 65536 FONT "Monaco",12 color 0,0,0,-1,-1,-1
   @ PIXELS 141,12 say "     - Command I - Close Issue " style 65536 FONT "Monaco",12 color 0,0,0,-1,-1,-1
   @ PIXELS 157,12 say "Code - Command F - Code File Maintenance" style 65536 FONT "Monaco",12 color 0,0,0,-1,-1,-1
   @ PIXELS 173,12 say "Util - Command U - Utilities" style 65536 FONT "Monaco",12 color 0,0,0,-1,-1,-1
   @ PIXELS 189,12 say "Sys  - Command S - System Parameters" style 65536 FONT "Monaco",12 color 0,0,0,-1,-1,-1
   @ PIXELS 205,12 say "Quit - Command Q - Quit to Main Menu" style 65536 FONT "Monaco",12 color 0,0,0,-1,-1,-1
   @ PIXELS 237,12 say "Choose Add an Account or Change an Account" style 65536 FONT "Monaco",12 color 0,0,0,-1,-1,-1
   @ PIXELS 253,12 say "to see what happens when you make a choice" style 65536 FONT "Monaco",12 color 0,0,0,-1,-1,-1

   close databases
   menu bar AZXTOP,10            && decreased by one to reflect missing option
   menu 1,ACCT,13,13             && increased by one to reflect added line
   menu 2,CTRC,9,9
   menu 3,AD,13,13
   menu 4,CASH,7,7
   menu 5,CLOX,1,1
   menu 6,ATG,10,10
   menu 7,CF,6,6
   menu 8,SY,1,1
   menu 9,UT,11,11
   *MENU 11,HLP,9,9              && deleted option
   menu 10,QT,1,1

   read menu bar to AXZCOL, AXZROW save

   menu off 1                    && turn menus off: this code will not activate
   menu off 2                    && other menu items during a read or wait
   menu off 3                    && except for items on the Apple menu like
   menu off 4                    && DA's.
   menu off 5                    && but turning off the menus will discourage
   menu off 6                    && users from trying -- they can still see
   menu off 7                    && menu options, they're just grayed out
   menu off 8
   menu off 9
   menu off 10

   *** rest of the code remains unchanged
   do case
   case AXZCOL=10  .and. AXZROW=1
      close data
      return
   case AXZCOL=1  .and. AXZROW=2
      do BOXPROG
   case AXZCOL=1  .and. AXZROW=3
      do help
   endcase
enddo

******************************************************************************
*** PRINPROG.PRG
*** Menu for various printing examples
******************************************************************************
procedure PRINPROG

private CHOICE
CHOICE=1
do while .t.
   set color to &CCLBOX
   clear
   @ 4,16 to 6,61 double
   @ 4,16 to 12,61 double
   set color to &CCLTITLE
   @ 5, 31 say "PRINTING EXAMPLES"
   set color to &CCLTEXT
   @ 8, 19 prompt "A. COLUMNS IN MONO VS PROPORTIONAL FONTS"
   @ 9, 19 prompt "B. REAL TIME PRINTING                   "
   @ 10, 19 prompt "Q. QUIT                                 "
   menu to CHOICE
   do case
   case CHOICE=1
      do PRINPRO1
   case CHOICE=2
      do PRINPRO2
   case CHOICE=3
      return
   endcase
enddo

******************************************************************************
*** PRINPRO1.PRG
*** Shows effects of proportional fonts on columns
******************************************************************************
procedure PRINPRO1
private TTITLE
clear
set color to &CCLBOX
@ 5, 7 say "COLUMNS IN MONOSPACED VS PROPORTIONAL FONTS"
@ 6, 7 say "==========================================="
set color to &CCLTEXT
@ 8, 7 say "The following examples show the effect of using a proportional font"
@ 9, 7 say "on reports that are generated with different programming techniques."
@ 10, 7 say "On the PC or on a Mac with a mono-spaced font, these reports will be"
@ 11, 7 say "identical (more or less). Since here we're using standard Mac"
@ 12, 7 say "printing (WSYISWYG), the 9 pt Monaco font will not fill up the"
@ 13, 7 say "width of the page."
@ 23,0
wait

store 'ON THE MAC THIS REPORT IS BEING PRINTED IN 9 PT MONACO - MONO SPACED FONT' to TTITLE
if MMAC
   set printer to                         && returns to standard Mac printing
                                          && screen/printing font already set
                                          && to 9 pt mono-spaced Monaco
endif
do report

store 'ON THE MAC THIS REPORT IS BEING PRINTED IN 12 PT CHICAGO - PROPORTIONAL FONT' to TTITLE
if MMAC
   screen FONT "Chicago", 12 lock        && whenever you issue a screen command
                                         && include LOCK so window cannot be
                                         && closed
endif
do report

if MMAC
   screen FONT "Monaco", 9  lock            && return to 9 pt Monaco screen font
   restore from 'PRINTER.MEM' additive      && set back to com port
   set printer to &PRNPORT,PRNBAUD,&PRNPARITY,&PRNDATA,&PRNSTOP,&PRNHAND,&PRNEND
endif

return

******************************************************************************
*** REPORT.PRG
*** Used by PRINPRO1.PRG
******************************************************************************
procedure report
private VVAR
dimension VVAR(40,1)
VVAR(1)='Something'
VVAR(2)='Another  '
VVAR(3)='Whatever '
VVAR(4)='Who      '
VVAR(5)='What     '
VVAR(6)='Which    '
VVAR(7)='Dogs     '
VVAR(8)='Cats     '
VVAR(9) ='Mice     '
VVAR(10)='Roses    '
VVAR(11)='Begonias '
VVAR(12)='Peonies  '
VVAR(13)='Bats     '
VVAR(14)='Hats     '
VVAR(15)='Bats/Hats'
VVAR(16)='Testing  '
VVAR(17)='Is Boring'
VVAR(18)='This, Too'
VVAR(19)=VVAR(1)
VVAR(20)=VVAR(2)
VVAR(21)=VVAR(3)
VVAR(22)=VVAR(4)
VVAR(23)=VVAR(5)
VVAR(24)=VVAR(6)
VVAR(25)=VVAR(7)
VVAR(26)=VVAR(8)
VVAR(27)=VVAR(9)
VVAR(28)=VVAR(10)
VVAR(29)=VVAR(11)
VVAR(30)=VVAR(12)
VVAR(31)=VVAR(13)
VVAR(32)=VVAR(14)
VVAR(33)=VVAR(15)
VVAR(34)=VVAR(16)
VVAR(35)=VVAR(17)
VVAR(36)=VVAR(18)
VVAR(37)='Something'
VVAR(38)='Another  '
VVAR(39)='Whatever '
VVAR(40)='Who      '

set device to print
@ 1,0 say TTITLE
@ 3,0 say 'This report uses precise horizontal placement of each data item with @ row,col.'
@ 4,0 say 'This particular coding method will produce columns that will align properly'
@ 5,0 say 'in proportional fonts, but letter spacing may not be what you desire.'

@ 7,0 say ' COLUMN1 '
@ 7,11 say ' COLUMN2 '
@ 7,22 say ' COLUMN3 '
@ 8,0 say '========='
@ 8,11 say '========='
@ 8,22 say '========='
store 9 to CNTR
store 1 to CNTR3
do while CNTR<=20
   @ CNTR,0 say VVAR(CNTR3)
   @ CNTR,11 say VVAR(CNTR3+1)
   @ CNTR,22 say VVAR(CNTR3+2)
   store CNTR+1 to CNTR
   store CNTR3+3 to CNTR3
enddo
eject

@ 1,0 say TTITLE
@ 3,0 say 'This report uses spaces to position horizontal elements. This coding'
@ 4,0 say 'method will not produce columns that align in proportional fonts.'

@ 6,0 say ' COLUMN1    COLUMN2    COLUMN3'
@ 7,0 say '=========  =========  ========='
store 8 to CNTR
store 1 to CNTR3
do while CNTR<=20
   @ CNTR,0 say VVAR(CNTR3)+'  '+VVAR(CNTR3+1)+'  '+VVAR(CNTR3+2)
   store CNTR+1 to CNTR
   store CNTR3+3 to CNTR3
enddo
eject

set device to screen
return

******************************************************************************
*** PRINPRO2.PRG
*** Shows problems with character/line spacing, real time printing
******************************************************************************
procedure PRINPRO2
clear
set color to &CCLBOX
@ 5, 4 say "REAL TIME PRINTING"
@ 6, 4 say "=================="
set color to &CCLTEXT
@ 8,4 say "The following examples show the effects of different programming techniques"
@ 9,4 say "on the way something is printed on the Mac. In these examples, we are trying"
@ 10,4 say "to print one label at a time (this would be used to allow a user to align"
@ 11,4 say "the label stock). On the PC, these will all print the same: one label after"
@ 12,4 say "another."
set color to &CCLWARN
@ 13,4 say "THESE EXAMPLES WERE DESIGNED FOR USE WITH AN IMPACT PRINTER"
@ 14,4 say "AND THIS PROCEDURE MAY TAKE A LOT OF PAPER"
@ 15,4 say "DO YOU WANT TO CONTINUE? (Y/N)"
set color to &CCLGET
OK='N'
@ 15,36 get OK picture '!' valid OK$'YN'
read
if OK='N'
   return
endif
clear
set color to &CCLTEXT
@ 9,4 say 'The following examples use common PC techniques to print labels.'
@ 10,4 say 'On the Mac, this batch will be printed using standard Mac printing.'
@ 12,4 say "First we'll start with labels printed using the ? command"
@ 13,4 say "Then we'll print labels with the @..SAY command"
@ 23,0
wait

if MMAC
   set printer to             && change to standard mac printing
endif
do LABELS1

clear
set color to &CCLTEXT
@ 9,4 say 'The following examples show revised code for use with the Mac and PC.'
@ 10, 4 say 'On the Mac, they will be printed with printer set to COM port'
@ 11,4 say 'at 10 chars/inch and 6/lines inch. Besides spacing differences,'
@ 12,4 say 'notice how much faster it prints.'
@ 14,4 say "See program comments for for more information."
@ 23,0
wait

if MMAC
   restore from 'PRINTER.MEM' additive      && set back to com port
   set printer to &PRNPORT,PRNBAUD,&PRNPARITY,&PRNDATA,&PRNSTOP,&PRNHAND,&PRNEND
   *** SET SPACING TO 10 CHARACTERS/INCH 6 LINES/INCH
   set print on
   ?? chr(27)+PRNCH10           && escape sequence for 10 chars/inch
   ?? chr(27)+PRN6LINE          && escape sequence for 6 lines/inch
   set print off
endif

do LABELS2

return

******************************************************************************
*** LABELS1.PRG
*** Used by PRINPRO2
******************************************************************************
procedure LABELS1
*** General comments:
*** Characters and line spacing in standard Mac printing are hard to control.
***    Both are functions of the font. Consequently, 6 lines in 9 pt Monaco
***    is not 1 inch nor are 10 characters 1 inch. It's hard to find just the
***    right font to print exactly where you want it to go. The first two sets
***    of labels, show these spacing problems.

*** Standard Mac printing and standard PC code:
***    When using a SET PRINT ON, A SET PRINT OFF ejects the page. So, in
***    the very first set of labels printed on the Mac, you will see one label
***    print, a page eject and then the remaining labels print.
***
***    Nothing comes out until you tell it to.
***    In both the examples here, when we're in the printing loop, labels will
***    print when the final SET PRINT OFF or EJECT command is issued. On the
***    PC, they would print one at a time.

***    The following code shows standard PC code for this kind of job running
***    in Mac with Mac standard printing.
set print on
?? 'This was printed using ?'
? 'line2'
? 'line3'
? 'line4'
? 'line5'
? 'line6'
set print off              && in standard printing this will eject the page
clear
store 'Y' to OK
set color to &CCLBOX
@ 6,4 say "USING THE ? COMMAND"
@ 7,4 say "==================="
@ 8,4 say 'HERE WE WANT TO PAUSE TO ALLOW THE USER TO ALIGN THE LABEL STOCK.'
@ 9,4 say 'WE WANT PRINTING TO RESUME WHERE IT LEFT OFF'
@ 19,4 say "Mac Notes:"
@ 20,4 say "Notice that although a label has printed, it has ejected the page."
@ 21,4 say "When you continue, nothing will print for awhile since we don't "
@ 22,4 say "SET PRINT OFF until the very end."
set color to &CCLTEXT
@ 11,4 say 'DO YOU WANT TO PRINT MORE LABELS? (Y/N) '
set color to &CCLGET
@ row(),col() get OK picture '!' valid OK$'YN'
read
if OK='Y'
   set print on
   CNTR=1
   do while CNTR<=15
      ? 'This was printed using ?'
      ? 'line2'
      ? 'line3'
      ? 'line4'
      ? 'line5'
      ? 'line6'
      CNTR=CNTR+1
   enddo
   set print off    && ejects the page in standard mac printing
endif

*** The following code shows standard PC code running in Mac standard printing.

set device to print
store 0 to CNTR2
@ CNTR2,0 say  'This was printed using @ SAY'
@ CNTR2+1, 0 say  'line2'
@ CNTR2+2, 0 say 'line3'
@ CNTR2+3, 0 say 'line4'
@ CNTR2+4, 0 say 'line5'
@ CNTR2+5, 0 say 'line6'
CNTR2=CNTR2+6
set device to screen
clear
store 'Y' to OK
set color to &CCLBOX
@ 6,4 say "USING THE @..SAY COMMAND"
@ 7,4 say "========================"
@ 8,4 say 'HERE WE WANT TO PAUSE TO ALLOW THE USER TO ALIGN THE LABEL STOCK.'
@ 9,4 say 'WE WANT PRINTING TO RESUME WHERE IT LEFT OFF'
@ 19,4 say "Mac notes:"
@ 20,4 say "Notice that nothing has printed yet. That's because this is PC code"
@ 21,4 say "and we have not issued a SET PRINTER TO or EJECT command. Notice that"
@ 22,4 say "nothing will print for awhile because we don't issue that command"
@ 23,4 say 'until the very end.'
set color to &CCLTEXT
@ 11,4 say 'DO YOU WANT TO PRINT MORE LABELS? (Y/N) '
set color to &CCLGET
@ row(),col() get OK picture '!' valid OK$'YN'
read
if OK='Y'
   set device to print
   store 1 to CNTR
   do while CNTR<=15
      @ CNTR2,0 say  'This was printed using @ SAY'
      @ CNTR2+1, 0 say  'line2'
      @ CNTR2+2, 0 say 'line3'
      @ CNTR2+3, 0 say 'line4'
      @ CNTR2+4, 0 say 'line5'
      @ CNTR2+5, 0 say 'line6'
      CNTR=CNTR+1
      CNTR2=CNTR2+6
   enddo
   eject                      && set printer to also works but don't use
                              && if you're printing to COM
   set device to screen
endif

******************************************************************************
*** LABELS2.PRG
*** Used by PRINPRO2
******************************************************************************
procedure LABELS2

*** For "real time" printing -- printing one thing at a time, especially to
*** allow a pause for forms alignment -- it's necessary to use a combination
*** of ? and SET PRINT ON/OFF commands. This is especially true when using
*** the @...SAY COMMAND which also requires the SET DEVICE TO PRINT/SCREEN
*** command.


set print on
?? 'This was printed using ?'
? 'line2'
? 'line3'
? 'line4'
? 'line5'
? 'line6'
set print off
clear
store 'Y' to OK
set color to &CCLBOX
@ 6,4 say "USING THE ? COMMAND"
@ 7,4 say "========================"
@ 8,4 say 'HERE WE WANT TO PAUSE TO ALLOW THE USER TO ALIGN THE LABEL STOCK.'
@ 9,4 say 'WE WANT PRINTING TO RESUME WHERE IT LEFT OFF'
@ 19,4 say "Mac notes:"
@ 20,4 say "Notice that a label has printed. The next label will be printed"
@ 21,4 say "on the next line. Each label will be printed in real time."
set color to &CCLTEXT
@ 11,4 say 'DO YOU WANT TO PRINT MORE LABELS? (Y/N) '
set color to &CCLGET
@ row(),col() get OK picture '!' valid OK$'YN'
read
if OK='Y'
   CNTR=1
   do while CNTR<=15
      set print on
      if MMAC
         pcol=0
         ?? 'This was printed using?'       && The reason for this code on the
                                            && Mac is a little difficult to
                                            && explain. OK, I don't *know*
                                            && why it works, it just does and
                                            && at this point I don't care
                                            && anymore. So sue me.

      else
         ? 'This was printed using ?'
      endif
      ? 'line2'
      ? 'line3'
      ? 'line4'
      ? 'line5'
      ? 'line6'
      CNTR=CNTR+1
      set print off
   enddo
endif

set device to print
set print on
store 0 to CNTR2
@ CNTR2,0 say  'This was printed using @ SAY'
@ CNTR2+1, 0 say  'line2'
@ CNTR2+2, 0 say 'line3'
@ CNTR2+3, 0 say 'line4'
@ CNTR2+4, 0 say 'line5'
@ CNTR2+5, 0 say 'line6'
?
if MMAC
   CNTR2=0                          && with incrementing counters on the Mac
                                    && reset counter to 0 each time
else
   CNTR2=CNTR2+6
endif
set device to screen                && the SET DEVICE TO SCREEN and
set print off                       && SET PRINT OFF commands
                                    && must be exactly in this order to work
clear
store 'Y' to OK
set color to &CCLBOX
@ 6,4 say "USING THE @..SAY COMMAND"
@ 7,4 say "========================"
@ 8,4 say 'HERE WE WANT TO PAUSE TO ALLOW THE USER TO ALIGN THE LABEL STOCK.'
@ 9,4 say 'WE WANT PRINTING TO RESUME WHERE IT LEFT OFF'
@ 19,4 say "Mac notes:"
@ 20,4 say "Notice that a label has printed. The next label will be printed"
@ 21,4 say "on the next line. Each label will be printed in real time."
set color to &CCLTEXT
@ 11,4 say 'DO YOU WANT TO PRINT MORE LABELS? (Y/N) '
set color to &CCLGET
@ row(),col() get OK picture '!' valid OK$'YN'
read
if .not. MMAC
  set console off                      && saves screen scrolling on the PC
endif
if OK='Y'
   store 1 to CNTR
   do while CNTR<=15
      set device to print                  && both these commands are necessary
      set print on                         && for Mac to allow use of ?
      @ CNTR2,0 say  'This was printed using @ SAY'
      @ CNTR2+1, 0 say  'line2'
      @ CNTR2+2, 0 say 'line3'
      @ CNTR2+3, 0 say 'line4'
      @ CNTR2+4, 0 say 'line5'
      @ CNTR2+5, 0 say 'line6'
      ?
      CNTR=CNTR+1
      if MMAC
         CNTR2=0                           && because prow() = 0
      else
         CNTR2=CNTR2+6
      endif                              && for real time printing:
      set device to screen               && <-both these commands are necessary
      set print off                      && <-and exactly in this order
                                         && even if you aren't returning to the
                                         && screen at this moment
   enddo
endif
set device to print
eject
set device to screen
set console on




******************************************************************************
*** HELP.PRG
*** Your existing help routine -- not using a Mac help file
******************************************************************************
procedure help

clear
set color to &CCLBOX
@ 2,17 to 10,58 double
set color to &CCLTITLE
@ 4, 30 say "NO HELP AT ALL    "
set color to &CCLTEXT
@ 7, 25 say "Your help routine goes here."

*** sample get
@ 16,0 say "Here's a sample GET. If you want to see how the color commands"
@ 17,0 say "work with this, try setting color to W/N,N/W"
* set color to W/N,N/W
set color to &CCLGET
OK='HIYA'
@ 19,0 get OK picture '!!!!'
read
@ 23,0
wait
return


******************************************************************************
*** ABOUT.PRG
*** Shows an "about your program" message
******************************************************************************
procedure ABOUT

clear
screen 5 type 1  at 0,0 size 197,385 pixels  font "Geneva",12 color 0,0,0,-1,-1,-1 top
@ pixels 45,94 say "DISPLAY/390" style 65536 font "New York",24 color 0,0,0,-1,-1,-1
@ pixels 81,37 say "Ad Scheduling and Accounts Receivable Software" style 65536 font "Chicago",12 color 0,0,0,-1,-1,-1
@ pixels 117,87 say "(c) 1989, 1990 Nancy Jacobsen" style 65536 font "Geneva",12 color 0,0,0,-1,-1,-1
@ pixels 133,84 say "Pacific Sun Computer Systems" style 65536 font "Geneva",12 color 0,0,0,-1,-1,-1
wait
screen 5 off
screen 5 delete
screen 1 top lock
retry